(library (alist-procs)
  (export alist-refs
          alist-set
          alist-item-key
          alist-item-value
          alist-find-item-by-value
          alist-find-item-by-key)
  (import (rnrs base)
          (only (guile)
                lambda* λ
                ;; command line args
                program-arguments
                simple-format
                current-output-port)
          ;; GNU Guile batteries
          (ice-9 exceptions)
          ;; SRFIs
          ;; SRFI 1 - list procs
          (srfi srfi-1)
          ;; SRFI 43 - vector procs
          (srfi srfi-43)
          ;; SRFI 69 - hash tables
          (srfi srfi-69)))


(define rest cdr)


(define alist-item-key
  (λ (item)
    "Get the key of the given ITEM of an alist."
    (first item)))


(define alist-item-value
  (λ (item)
    "Get the value of the given ITEM of an alist."
    (cdr item)))


(define alist-find-item-by-value
  (lambda* (val alst #:key (equal-test equal?))
    "Find an item of the given alist ALST by given value VAL
and return it."
    (find (λ (entry)
            (equal-test (cdr entry) val))
          alst)))


(define alist-find-item-by-key
  (lambda* (key alst #:key (equal-test equal?))
    "Find an item of the given alist ALST by given key KEY
and return it."
    (find (λ (entry)
            (equal-test (first entry) key))
          alst)))


(define alist-refs
  (lambda* (alist refs #:key (default-thunk #f) (equal-test equal?))
    ;; (simple-format (current-output-port) "remaining refs for alist: ~a\n" refs)
    (cond
     ;; If no more refs are given, we must have found what
     ;; we are looking for.
     [(null? refs) alist]
     [(pair? alist)
      (cond
       ;; If there are no more entries in the current alist,
       ;; then we could not find the searched key.
       [(null? alist)
        ;; If a default thunk was given, call it, otherwise
        ;; raise an exception.
        (if default-thunk
            (default-thunk)
            (raise-exception
             (make-exception (make-non-continuable-error)
                             (make-exception-with-message "key not found")
                             (make-exception-with-irritants (list refs alist))
                             (make-exception-with-origin 'alist-refs))))]
       [else
        (let ([ref (first refs)]
              [item (first alist)])
          (cond
           [(equal-test (alist-item-key item) ref)
            (alist-refs (alist-item-value item)
                        (cdr refs)
                        #:default-thunk default-thunk
                        #:equal-test equal-test)]
           [else
            (alist-refs (cdr alist)
                        refs
                        #:default-thunk default-thunk
                        #:equal-test equal-test)]))])]
     [else
      ;; (simple-format (current-output-port) "not a pair: ~a\n" alist)
      (if default-thunk
          (default-thunk)
          (raise-exception
           (make-exception (make-non-continuable-error)
                           (make-exception-with-message "key not found")
                           (make-exception-with-irritants (list refs alist))
                           (make-exception-with-origin 'alist-refs))))])))


(define alist-set
  (lambda* (alst key val #:key (equal-test equal?))
    "Set a given value VAL for a given KEY in the given
association list ALST."
    (cond
     [(null? alst) (cons (cons key val) '())]
     [else
      (let ([current-assoc (first alst)])
        (cond
         [(equal-test (alist-item-key current-assoc) key)
          (cons (cons key val)
                (rest alst))]
         [else
          (cons current-assoc
                (alist-set (rest alst)
                           key
                           val
                           #:equal-test equal-test))]))])))
